home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / amigaunits / commodities.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  14.5 KB  |  602 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998-2000 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. {
  17.     History:
  18.     Added overlay functions for Pchar->Strings, functions
  19.     and procedures.
  20.  
  21.     14 Jul 2000.
  22.     nils.sjoholm@mailbox.swipnet.se
  23. }
  24.  
  25. unit commodities;
  26.  
  27. INTERFACE
  28.  
  29. {$I amigaoverlays.inc}
  30.  
  31. uses exec, inputevent, keymap;
  32.  
  33.  
  34.  
  35. {    **************
  36.  * Broker stuff
  37.  **************}
  38.  
  39. CONST
  40. {     buffer sizes   }
  41.       CBD_NAMELEN   =  24;
  42.       CBD_TITLELEN  =  40;
  43.       CBD_DESCRLEN  =  40;
  44.  
  45. {     CxBroker errors   }
  46.       CBERR_OK      =  0;        {     No error                         }
  47.       CBERR_SYSERR  =  1;        {     System error , no memory, etc    }
  48.       CBERR_DUP     =  2;        {     uniqueness violation             }
  49.       CBERR_VERSION =  3;        {     didn't understand nb_VERSION     }
  50.  
  51.       NB_VERSION    =  5;        {     Version of NewBroker structure   }
  52.  
  53. Type
  54.   pNewBroker = ^tNewBroker;
  55.   tNewBroker = record
  56.    nb_Version   : Shortint;  {     set to NB_VERSION                }
  57.    nb_Name,
  58.    nb_Title,
  59.    nb_Descr     : STRPTR;
  60.    nb_Unique,
  61.    nb_Flags     : Integer;
  62.    nb_Pri       : Shortint;
  63.    {     new in V5   }
  64.    nb_Port      : pMsgPort;
  65.    nb_ReservedChannel  : Integer;  {     plans for later port sharing     }
  66.   END;
  67.  
  68. CONST
  69. {     Flags for nb_Unique }
  70.       NBU_DUPLICATE  = 0;
  71.       NBU_UNIQUE     = 1;        {     will not allow duplicates        }
  72.       NBU_NOTIFY     = 2;        {     sends CXM_UNIQUE to existing broker }
  73.  
  74. {     Flags for nb_Flags }
  75.         COF_SHOW_HIDE = 4;
  76.  
  77. {    *******
  78.  * cxusr
  79.  *******}
  80.  
  81. {    * Fake data types for system private objects   }
  82. Type
  83.   CxObj = Longint;
  84.   pCxObj = ^CxObj;
  85.   CxMsg = Longint;
  86.   pCXMsg = ^CxMsg;
  87.  
  88.  
  89. CONST
  90. {    ******************************}
  91. {    * Commodities Object Types   *}
  92. {    ******************************}
  93.       CX_INVALID     = 0;     {     not a valid object (probably null)  }
  94.       CX_FILTER      = 1;     {     input event messages only           }
  95.       CX_TYPEFILTER  = 2;     {     filter on message type      }
  96.       CX_SEND        = 3;     {     sends a message                     }
  97.       CX_SIGNAL      = 4;     {     sends a signal              }
  98.       CX_TRANSLATE   = 5;     {     translates IE into chain            }
  99.       CX_BROKER      = 6;     {     application representative          }
  100.       CX_DEBUG       = 7;     {     dumps kprintf to serial port        }
  101.       CX_CUSTOM      = 8;     {     application provids function        }
  102.       CX_ZERO        = 9;     {     system terminator node      }
  103.  
  104. {    ***************}
  105. {    * CxMsg types *}
  106. {    ***************}
  107.       CXM_UNIQUE     = 16;    {     sent down broker by CxBroker()      }
  108. {     Obsolete: subsumed by CXM_COMMAND (below)   }
  109.  
  110. {     Messages of this type rattle around the Commodities input network.
  111.  * They will be sent to you by a Sender object, and passed to you
  112.  * as a synchronous function call by a Custom object.
  113.  *
  114.  * The message port or function entry point is stored in the object,
  115.  * and the ID field of the message will be set to what you arrange
  116.  * issuing object.
  117.  *
  118.  * The Data field will point to the input event triggering the
  119.  * message.
  120.  }
  121.       CXM_IEVENT     = 32;
  122.  
  123. {     These messages are sent to a port attached to your Broker.
  124.  * They are sent to you when the controller program wants your
  125.  * program to do something.  The ID field identifies the command.
  126.  *
  127.  * The Data field will be used later.
  128.  }
  129.       CXM_COMMAND    = 64;
  130.  
  131. {     ID values   }
  132.       CXCMD_DISABLE   = (15);   {     please disable yourself       }
  133.       CXCMD_ENABLE    = (17);   {     please enable yourself        }
  134.       CXCMD_APPEAR    = (19);   {     open your window, if you can  }
  135.       CXCMD_DISAPPEAR = (21);   {     go dormant                    }
  136.       CXCMD_KILL      = (23);   {     go away for good              }
  137.       CXCMD_UNIQUE    = (25);   {     someone tried to create a broker
  138.                                * with your name.  Suggest you Appear.
  139.                                }
  140.       CXCMD_LIST_CHG  = (27);  {     Used by Exchange program. Someone }
  141.                               {     has changed the broker list       }
  142.  
  143. {     return values for BrokerCommand(): }
  144.       CMDE_OK        = (0);
  145.       CMDE_NOBROKER  = (-1);
  146.       CMDE_NOPORT    = (-2);
  147.       CMDE_NOMEM     = (-3);
  148.  
  149. {     IMPORTANT NOTE: for V5:
  150.  * Only CXM_IEVENT messages are passed through the input network.
  151.  *
  152.  * Other types of messages are sent to an optional port in your broker.
  153.  *
  154.  * This means that you must test the message type in your message handling,
  155.  * if input messages and command messages come to the same port.
  156.  *
  157.  * Older programs have no broker port, so processing loops which
  158.  * make assumptions about type won't encounter the new message types.
  159.  *
  160.  * The TypeFilter CxObject is hereby obsolete.
  161.  *
  162.  * It is less convenient for the application, but eliminates testing
  163.  * for type of input messages.
  164.  }
  165.  
  166. {    ********************************************************}
  167. {    * CxObj Error Flags (return values from CxObjError())  *}
  168. {    ********************************************************}
  169.       COERR_ISNULL      = 1;  {     you called CxError(NULL)            }
  170.       COERR_NULLATTACH  = 2;  {     someone attached NULL to my list    }
  171.       COERR_BADFILTER   = 4;  {     a bad filter description was given  }
  172.       COERR_BADTYPE     = 8;  {     unmatched type-specific operation   }
  173.  
  174.  
  175. {    ****************************}
  176. {     Input Expression structure }
  177. {    ****************************}
  178.  
  179.       IX_VERSION        = 2;
  180.  
  181. Type
  182.   pInputXpression = ^tInputXpression;
  183.   tInputXpression = record
  184.    ix_Version,               {     must be set to IX_VERSION  }
  185.    ix_Class    : Byte;       {     class must match exactly   }
  186.  
  187.    ix_Code     : Word;      {     Bits that we want  }
  188.  
  189.    ix_CodeMask : Word;      {     Set bits here to indicate  }
  190.                              {     which bits in ix_Code are  }
  191.                              {     don't care bits.           }
  192.  
  193.    ix_Qualifier: Word;      {     Bits that we want  }
  194.  
  195.    ix_QualMask : Word;      {     Set bits here to indicate  }
  196.                            {     which bits in ix_Qualifier }
  197.                                                    {     are don't care bits        }
  198.  
  199.    ix_QualSame : Word;    {     synonyms in qualifier      }
  200.   END;
  201.  
  202.    IX = tInputXpression;
  203.    pIX = ^IX;
  204.  
  205. CONST
  206. {     QualSame identifiers }
  207.       IXSYM_SHIFT = 1;     {     left- and right- shift are equivalent     }
  208.       IXSYM_CAPS  = 2;     {     either shift or caps lock are equivalent  }
  209.       IXSYM_ALT   = 4;     {     left- and right- alt are equivalent       }
  210.  
  211. {     corresponding QualSame masks }
  212.       IXSYM_SHIFTMASK = (IEQUALIFIER_LSHIFT + IEQUALIFIER_RSHIFT);
  213.       IXSYM_CAPSMASK  = (IXSYM_SHIFTMASK    + IEQUALIFIER_CAPSLOCK);
  214.       IXSYM_ALTMASK   = (IEQUALIFIER_LALT   + IEQUALIFIER_RALT);
  215.  
  216.       IX_NORMALQUALS  = $7FFF;   {     for QualMask field: avoid RELATIVEMOUSE }
  217.  
  218.  
  219. VAR CxBase : pLibrary;
  220.  
  221. FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT;
  222. PROCEDURE AddIEvents(events : pInputEvent);
  223. PROCEDURE AttachCxObj(headObj : pCxObj; co : pCxObj);
  224. PROCEDURE ClearCxObjError(co : pCxObj);
  225. FUNCTION CreateCxObj(typ : ULONG; arg1 : LONGINT; arg2 : LONGINT): pCxObj;
  226. FUNCTION CxBroker(nb : pNewBroker; error : pCxObj) : pCxObj;
  227. FUNCTION CxMsgData(cxm : pCxMsg) : POINTER;
  228. FUNCTION CxMsgID(cxm : pCxMsg) : LONGINT;
  229. FUNCTION CxMsgType(cxm : pCxMsg) : ULONG;
  230. FUNCTION CxObjError(co : pCxObj) : LONGINT;
  231. FUNCTION CxObjType(co : pCxObj) : ULONG;
  232. PROCEDURE DeleteCxObj(co : pCxObj);
  233. PROCEDURE DeleteCxObjAll(co : pCxObj);
  234. PROCEDURE DisposeCxMsg(cxm : pCxMsg);
  235. PROCEDURE DivertCxMsg(cxm : pCxMsg; headObj : pCxObj; returnObj : pCxObj);
  236. PROCEDURE EnqueueCxObj(headObj : pCxObj; co : pCxObj);
  237. PROCEDURE InsertCxObj(headObj : pCxObj; co : pCxObj; pred : pCxObj);
  238. FUNCTION InvertKeyMap(ansiCode : ULONG; event : pInputEvent; km : pKeyMap) : BOOLEAN;
  239. FUNCTION MatchIX(event : pInputEvent; ix : pInputXpression) : BOOLEAN;
  240. FUNCTION ParseIX(description : pCHAR; ix : pInputXpression) : LONGINT;
  241. PROCEDURE RemoveCxObj(co : pCxObj);
  242. PROCEDURE RouteCxMsg(cxm : pCxMsg; co : pCxObj);
  243. FUNCTION SetCxObjPri(co : pCxObj; pri : LONGINT) : LONGINT;
  244. PROCEDURE SetFilter(filter : pCxObj; text : pCHAR);
  245. PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression);
  246. PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent);
  247.  
  248. {$ifdef amiga_overlays}
  249.  
  250. FUNCTION ParseIX(description : string; ix : pInputXpression) : LONGINT;
  251. PROCEDURE SetFilter(filter : pCxObj; text : string);
  252.  
  253. {$endif}
  254.  
  255. IMPLEMENTATION
  256.  
  257. {$ifdef amiga_overlays}
  258. uses pastoc;
  259. {$endif}
  260.  
  261. FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT;
  262. BEGIN
  263.   ASM
  264.     MOVE.L  A6,-(A7)
  265.     MOVEA.L co,A0
  266.     MOVE.L  tru,D0
  267.     MOVEA.L CxBase,A6
  268.     JSR -042(A6)
  269.     MOVEA.L (A7)+,A6
  270.     MOVE.L  D0,@RESULT
  271.   END;
  272. END;
  273.  
  274. PROCEDURE AddIEvents(events : pInputEvent);
  275. BEGIN
  276.   ASM
  277.     MOVE.L  A6,-(A7)
  278.     MOVEA.L events,A0
  279.     MOVEA.L CxBase,A6
  280.     JSR -180(A6)
  281.     MOVEA.L (A7)+,A6
  282.   END;
  283. END;
  284.  
  285. PROCEDURE AttachCxObj(headObj : pCxObj; co : pCxObj);
  286. BEGIN
  287.   ASM
  288.     MOVE.L  A6,-(A7)
  289.     MOVEA.L headObj,A0
  290.     MOVEA.L co,A1
  291.     MOVEA.L CxBase,A6
  292.     JSR -084(A6)
  293.     MOVEA.L (A7)+,A6
  294.   END;
  295. END;
  296.  
  297. PROCEDURE ClearCxObjError(co : pCxObj);
  298. BEGIN
  299.   ASM
  300.     MOVE.L  A6,-(A7)
  301.     MOVEA.L co,A0
  302.     MOVEA.L CxBase,A6
  303.     JSR -072(A6)
  304.     MOVEA.L (A7)+,A6
  305.   END;
  306. END;
  307.  
  308. FUNCTION CreateCxObj(typ : ULONG; arg1 : LONGINT; arg2 : LONGINT) : pCxObj;
  309. BEGIN
  310.   ASM
  311.     MOVE.L  A6,-(A7)
  312.     MOVE.L  typ,D0
  313.     MOVEA.L arg1,A0
  314.     MOVEA.L arg2,A1
  315.     MOVEA.L CxBase,A6
  316.     JSR -030(A6)
  317.     MOVEA.L (A7)+,A6
  318.     MOVE.L  D0,@RESULT
  319.   END;
  320. END;
  321.  
  322. FUNCTION CxBroker(nb : pNewBroker; error : pCxObj) : pCxObj;
  323. BEGIN
  324.   ASM
  325.     MOVE.L  A6,-(A7)
  326.     MOVEA.L nb,A0
  327.     MOVE.L  error,D0
  328.     MOVEA.L CxBase,A6
  329.     JSR -036(A6)
  330.     MOVEA.L (A7)+,A6
  331.     MOVE.L  D0,@RESULT
  332.   END;
  333. END;
  334.  
  335. FUNCTION CxMsgData(cxm : pCxMsg) : POINTER;
  336. BEGIN
  337.   ASM
  338.     MOVE.L  A6,-(A7)
  339.     MOVEA.L cxm,A0
  340.     MOVEA.L CxBase,A6
  341.     JSR -144(A6)
  342.     MOVEA.L (A7)+,A6
  343.     MOVE.L  D0,@RESULT
  344.   END;
  345. END;
  346.  
  347. FUNCTION CxMsgID(cxm : pCxMsg) : LONGINT;
  348. BEGIN
  349.   ASM
  350.     MOVE.L  A6,-(A7)
  351.     MOVEA.L cxm,A0
  352.     MOVEA.L CxBase,A6
  353.     JSR -150(A6)
  354.     MOVEA.L (A7)+,A6
  355.     MOVE.L  D0,@RESULT
  356.   END;
  357. END;
  358.  
  359. FUNCTION CxMsgType(cxm : pCxMsg) : ULONG;
  360. BEGIN
  361.   ASM
  362.     MOVE.L  A6,-(A7)
  363.     MOVEA.L cxm,A0
  364.     MOVEA.L CxBase,A6
  365.     JSR -138(A6)
  366.     MOVEA.L (A7)+,A6
  367.     MOVE.L  D0,@RESULT
  368.   END;
  369. END;
  370.  
  371. FUNCTION CxObjError(co : pCxObj) : LONGINT;
  372. BEGIN
  373.   ASM
  374.     MOVE.L  A6,-(A7)
  375.     MOVEA.L co,A0
  376.     MOVEA.L CxBase,A6
  377.     JSR -066(A6)
  378.     MOVEA.L (A7)+,A6
  379.     MOVE.L  D0,@RESULT
  380.   END;
  381. END;
  382.  
  383. FUNCTION CxObjType(co : pCxObj) : ULONG;
  384. BEGIN
  385.   ASM
  386.     MOVE.L  A6,-(A7)
  387.     MOVEA.L co,A0
  388.     MOVEA.L CxBase,A6
  389.     JSR -060(A6)
  390.     MOVEA.L (A7)+,A6
  391.     MOVE.L  D0,@RESULT
  392.   END;
  393. END;
  394.  
  395. PROCEDURE DeleteCxObj(co : pCxObj);
  396. BEGIN
  397.   ASM
  398.     MOVE.L  A6,-(A7)
  399.     MOVEA.L co,A0
  400.     MOVEA.L CxBase,A6
  401.     JSR -048(A6)
  402.     MOVEA.L (A7)+,A6
  403.   END;
  404. END;
  405.  
  406. PROCEDURE DeleteCxObjAll(co : pCxObj);
  407. BEGIN
  408.   ASM
  409.     MOVE.L  A6,-(A7)
  410.     MOVEA.L co,A0
  411.     MOVEA.L CxBase,A6
  412.     JSR -054(A6)
  413.     MOVEA.L (A7)+,A6
  414.   END;
  415. END;
  416.  
  417. PROCEDURE DisposeCxMsg(cxm : pCxMsg);
  418. BEGIN
  419.   ASM
  420.     MOVE.L  A6,-(A7)
  421.     MOVEA.L cxm,A0
  422.     MOVEA.L CxBase,A6
  423.     JSR -168(A6)
  424.     MOVEA.L (A7)+,A6
  425.   END;
  426. END;
  427.  
  428. PROCEDURE DivertCxMsg(cxm : pCxMsg; headObj : pCxObj; returnObj : pCxObj);
  429. BEGIN
  430.   ASM
  431.     MOVE.L  A6,-(A7)
  432.     MOVEA.L cxm,A0
  433.     MOVEA.L headObj,A1
  434.     MOVEA.L returnObj,A2
  435.     MOVEA.L CxBase,A6
  436.     JSR -156(A6)
  437.     MOVEA.L (A7)+,A6
  438.   END;
  439. END;
  440.  
  441. PROCEDURE EnqueueCxObj(headObj : pCxObj; co : pCxObj);
  442. BEGIN
  443.   ASM
  444.     MOVE.L  A6,-(A7)
  445.     MOVEA.L headObj,A0
  446.     MOVEA.L co,A1
  447.     MOVEA.L CxBase,A6
  448.     JSR -090(A6)
  449.     MOVEA.L (A7)+,A6
  450.   END;
  451. END;
  452.  
  453. PROCEDURE InsertCxObj(headObj : pCxObj; co : pCxObj; pred : pCxObj);
  454. BEGIN
  455.   ASM
  456.     MOVE.L  A6,-(A7)
  457.     MOVEA.L headObj,A0
  458.     MOVEA.L co,A1
  459.     MOVEA.L pred,A2
  460.     MOVEA.L CxBase,A6
  461.     JSR -096(A6)
  462.     MOVEA.L (A7)+,A6
  463.   END;
  464. END;
  465.  
  466. FUNCTION InvertKeyMap(ansiCode : ULONG; event : pInputEvent; km : pKeyMap) : BOOLEAN;
  467. BEGIN
  468.   ASM
  469.     MOVE.L  A6,-(A7)
  470.     MOVE.L  ansiCode,D0
  471.     MOVEA.L event,A0
  472.     MOVEA.L km,A1
  473.     MOVEA.L CxBase,A6
  474.     JSR -174(A6)
  475.     MOVEA.L (A7)+,A6
  476.     TST.W   D0
  477.     BEQ.B   @end
  478.     MOVEQ   #1,D0
  479.   @end: MOVE.B  D0,@RESULT
  480.   END;
  481. END;
  482.  
  483. FUNCTION MatchIX(event : pInputEvent; ix : pInputXpression) : BOOLEAN;
  484. BEGIN
  485.   ASM
  486.     MOVE.L  A6,-(A7)
  487.     MOVEA.L event,A0
  488.     MOVEA.L ix,A1
  489.     MOVEA.L CxBase,A6
  490.     JSR -204(A6)
  491.     MOVEA.L (A7)+,A6
  492.     TST.W   D0
  493.     BEQ.B   @end
  494.     MOVEQ   #1,D0
  495.   @end: MOVE.B  D0,@RESULT
  496.   END;
  497. END;
  498.  
  499. FUNCTION ParseIX(description : pCHAR; ix : pInputXpression) : LONGINT;
  500. BEGIN
  501.   ASM
  502.     MOVE.L  A6,-(A7)
  503.     MOVEA.L description,A0
  504.     MOVEA.L ix,A1
  505.     MOVEA.L CxBase,A6
  506.     JSR -132(A6)
  507.     MOVEA.L (A7)+,A6
  508.     MOVE.L  D0,@RESULT
  509.   END;
  510. END;
  511.  
  512. PROCEDURE RemoveCxObj(co : pCxObj);
  513. BEGIN
  514.   ASM
  515.     MOVE.L  A6,-(A7)
  516.     MOVEA.L co,A0
  517.     MOVEA.L CxBase,A6
  518.     JSR -102(A6)
  519.     MOVEA.L (A7)+,A6
  520.   END;
  521. END;
  522.  
  523. PROCEDURE RouteCxMsg(cxm : pCxMsg; co : pCxObj);
  524. BEGIN
  525.   ASM
  526.     MOVE.L  A6,-(A7)
  527.     MOVEA.L cxm,A0
  528.     MOVEA.L co,A1
  529.     MOVEA.L CxBase,A6
  530.     JSR -162(A6)
  531.     MOVEA.L (A7)+,A6
  532.   END;
  533. END;
  534.  
  535. FUNCTION SetCxObjPri(co : pCxObj; pri : LONGINT) : LONGINT;
  536. BEGIN
  537.   ASM
  538.     MOVE.L  A6,-(A7)
  539.     MOVEA.L co,A0
  540.     MOVE.L  pri,D0
  541.     MOVEA.L CxBase,A6
  542.     JSR -078(A6)
  543.     MOVEA.L (A7)+,A6
  544.     MOVE.L  D0,@RESULT
  545.   END;
  546. END;
  547.  
  548. PROCEDURE SetFilter(filter : pCxObj; text : pCHAR);
  549. BEGIN
  550.   ASM
  551.     MOVE.L  A6,-(A7)
  552.     MOVEA.L filter,A0
  553.     MOVEA.L text,A1
  554.     MOVEA.L CxBase,A6
  555.     JSR -120(A6)
  556.     MOVEA.L (A7)+,A6
  557.   END;
  558. END;
  559.  
  560. PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression);
  561. BEGIN
  562.   ASM
  563.     MOVE.L  A6,-(A7)
  564.     MOVEA.L filter,A0
  565.     MOVEA.L ix,A1
  566.     MOVEA.L CxBase,A6
  567.     JSR -126(A6)
  568.     MOVEA.L (A7)+,A6
  569.   END;
  570. END;
  571.  
  572. PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent);
  573. BEGIN
  574.   ASM
  575.     MOVE.L  A6,-(A7)
  576.     MOVEA.L translator,A0
  577.     MOVEA.L events,A1
  578.     MOVEA.L CxBase,A6
  579.     JSR -114(A6)
  580.     MOVEA.L (A7)+,A6
  581.   END;
  582. END;
  583.  
  584. {$ifdef amiga_overlays}
  585.  
  586. FUNCTION ParseIX(description : string; ix : pInputXpression) : LONGINT;
  587. begin
  588.       ParseIX := ParseIX(pas2c(description),ix);
  589. end;
  590.  
  591. PROCEDURE SetFilter(filter : pCxObj; text : string);
  592. begin
  593.       SetFilter(filter,pas2c(text));
  594. end;
  595.  
  596. {$endif}
  597.  
  598. END. (* UNIT COMMODITIES *)
  599.  
  600.  
  601.  
  602.